Attribute VB_Name = "modStringFunctions"
Option Explicit
'*************************************************************************
'  This source code is provided "as is" and as an unsupported sample of
'  a Microsoft Visual Basic application that incorporates the MapPoint 2002
'  object model and ActiveX control. It can only  be used in accordance with
'  the terms and conditions of the Microsoft MapPoint 2002 and
'  Microsoft Visual Basic End User License Agreements.
'*************************************************************************
   Declare Function GetShortPathName Lib "kernel32" _
      Alias "GetShortPathNameA" (ByVal lpszLongPath As String, _
      ByVal lpszShortPath As String, ByVal cchBuffer As Long) As Long

Public Sub ParseFileAndPathName(ByVal sFullTitle As String, _
                                ByRef sPath As String, _
                                ByRef sFilename As String)
'**********************************************************************************
    ' Date: 4/3/2001
    ' Abstract: Splits a path/filename combination into separate Path and Filename
    '           components.
    ' Assumptions:
    ' Notes:
'**********************************************************************************
    
    Dim iDelimiterLocation As Integer
    
    On Error GoTo errorHandler
    
    'Find the location of the last backslash character.
    iDelimiterLocation = InStrRev(sFullTitle, "\")
    
    'Did we find one?
    If iDelimiterLocation > 0 Then
    
        'Found a backslash character -- split at the location of the character.
        sFilename = Mid$(sFullTitle, iDelimiterLocation + 1)
        sPath = Mid$(sFullTitle, 1, iDelimiterLocation - 1)
    Else
    
        'No backslash character found, so assume the entire string is a filename.
        sFilename = sFullTitle
        sPath = ""
    End If
    
    Exit Sub
errorHandler:
    MsgBox "Error in ParseFileAndPathName" & vbCrLf _
         & "Error Number: " & Err.Number & vbCrLf _
         & "Error Description: " & Err.Description, vbExclamation, App.Title
End Sub

Public Sub ParseFileNameAndExtension(ByVal sFileNameWithExtension As String, _
                                     ByRef sFilename As String, _
                                     ByRef sExtension As String)
'**********************************************************************************
    ' Date: 4/3/2001
    ' Abstract: Splits a filename into separate Filename and Extension
    '           components.
    ' Assumptions:
    ' Notes:
'**********************************************************************************
    
    Dim iPeriodPos As Integer
    
    'Look for the last period character.
    iPeriodPos = InStrRev(sFileNameWithExtension, ".")
    
    'Did we find one?
    If iPeriodPos <> 0 Then
    
        'Found a period character -- split the string into two parts.
        sFilename = Left$(sFileNameWithExtension, iPeriodPos - 1)
        sExtension = Mid$(sFileNameWithExtension, iPeriodPos)
    Else
        
        'Didn't find a period character -- return the entire string as
        'the filename, and return a blank extension.
        sFilename = sFileNameWithExtension
        sExtension = ""
    End If
    
End Sub


Public Function GetTextLines(sFilename As String) As String()

    Dim osFSO As Scripting.FileSystemObject
    Dim osTextStream As Scripting.TextStream
    Dim lArrayIndex As Long
    Dim sTextLine As String
    Dim asTextLines() As String
    
    Set osFSO = New Scripting.FileSystemObject
    Set osTextStream = osFSO.OpenTextFile(sFilename, ForReading, False, TristateFalse)
    
    Do While osTextStream.AtEndOfStream = False
        sTextLine = Trim$(osTextStream.ReadLine)
        If Len(sTextLine) <> 0 Then
            ReDim Preserve asTextLines(lArrayIndex) As String
            asTextLines(lArrayIndex) = sTextLine
            lArrayIndex = lArrayIndex + 1
        End If
    Loop
    
    osTextStream.Close
    
    GetTextLines = asTextLines
    
End Function

Public Function GetShortFilename(ByVal sLongFileName As String) As String
    
    Dim lRetVal As Long, sShortPathName As String, iLen As Integer
    'Set up buffer area for API function call return
    sShortPathName = Space(255)
    iLen = Len(sShortPathName)

    'Call the function
    lRetVal = GetShortPathName(sLongFileName, sShortPathName, iLen)
    'Strip away unwanted characters.
    GetShortFilename = Left(sShortPathName, lRetVal)
    
End Function
